home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel-075.lha / feel0.75 / Src / sockets.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  15KB  |  601 lines
  1. /* ******************************************************************** */
  2. /* sockets.c         Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Inter-processes communication                                    */
  5. /* ******************************************************************** */
  6.  
  7. #define PAUSE() 
  8.  
  9. /*
  10.  * Change Log:
  11.  *   Version 1, June 1990
  12.  */
  13.  
  14. static char *woo_woo = "WOO! WOO!"; /* To appease ncc */
  15.  
  16. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  17.  
  18. #include "funcalls.h"
  19. #include "defs.h"
  20. #include "structs.h"
  21. #include "error.h"
  22. #include "global.h"
  23.  
  24. #include "calls.h"
  25. #include "modboot.h"
  26. #include "allocate.h"
  27. #include "modules.h"
  28.  
  29. #include "symboot.h"
  30. #include "syssockets.h"
  31. #include "sio.h"
  32. #include "class.h"
  33.  
  34. /*
  35.  
  36.  * Socket stuff... 
  37.  
  38.  */
  39.  
  40. /* Globals... */
  41.  
  42. SYSTEM_GLOBAL(char *,host_machine_name);
  43. SYSTEM_GLOBAL(Host *,host_machine_ref);
  44. SYSTEM_GLOBAL(LispObject,host_machine_lisp_name);
  45.  
  46. /* classes */
  47. static LispObject Socket;
  48. static LispObject Listener;
  49. /* metaclasses -- maybe use primitive class */
  50.  
  51. EUFUN_1( Fn_listernerp, obj)
  52. {
  53.   return((is_listener(obj) ? lisptrue : nil));
  54. }
  55. EUFUN_CLOSE
  56.  
  57. EUFUN_1( Fn_socketp, obj)
  58. {
  59.   return((is_socket(obj) ? lisptrue : nil));
  60. }
  61. EUFUN_CLOSE
  62.  
  63. EUFUN_0( Fn_make_listener)
  64. {
  65.   LispObject listener;
  66.   int length;
  67.   int port;
  68.  
  69.   listener = allocate_listener(stacktop);
  70.  
  71.   if ((listener->LISTENER.socket = socket(AF_INET,SOCK_STREAM,0)) < 0) 
  72.     CallError(stacktop,
  73.           "make-;istener: unable to make socket",nil,NONCONTINUABLE);
  74.  
  75.   /* Bind it to look for anything... */
  76.  
  77.   listener->LISTENER.name.sin_family = AF_INET;
  78.   listener->LISTENER.name.sin_addr.s_addr = INADDR_ANY;
  79.   listener->LISTENER.name.sin_port = 0;
  80.  
  81.   length = sizeof(SocketInName);
  82.  
  83.   if (bind(listener->LISTENER.socket,
  84.        (SocketName *) &(listener->LISTENER.name),
  85.        length) < 0)
  86.     CallError(stacktop,"make-listener: can't bind socket",nil,NONCONTINUABLE);
  87.  
  88.   if (getsockname(listener->LISTENER.socket,
  89.           (SocketName *) &(listener->LISTENER.name),
  90.           &length) < 0)
  91.     CallError(stacktop,
  92.           "make-listener: can't get socket data",nil,NONCONTINUABLE);
  93.  
  94.   listener->LISTENER.state = SOCKET_VIRGIN;
  95.  
  96.   listen(listener->LISTENER.socket,5); /* One step at a time... */
  97.  
  98.   lval_classof(listener) = Listener; 
  99.   return(listener);
  100. }
  101. EUFUN_CLOSE
  102.  
  103. EUFUN_0( Fn_make_socket)
  104. {
  105.   LispObject lispsock;
  106.  
  107.   lispsock = allocate_socket(stacktop);
  108.  
  109.   if ((lispsock->SOCKET.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
  110.     CallError(stacktop,
  111.           "make-socket: unable to make socket",nil,NONCONTINUABLE);
  112.  
  113.   lispsock->SOCKET.state = SOCKET_VIRGIN;
  114.   
  115.   lval_classof(lispsock) = Socket;
  116.  
  117.   return(lispsock);
  118. }
  119. EUFUN_CLOSE
  120.   
  121. EUFUN_1( Fn_listener_id, sock)
  122. {
  123.   LispObject data;
  124.  
  125.   if (!is_listener(sock))
  126.     CallError(stacktop,"listener-id: not a listener",sock,NONCONTINUABLE);
  127.  
  128.   if (sock->LISTENER.state != SOCKET_VIRGIN)
  129.     CallError(stacktop,"listener-id: socket not virgin ",sock,NONCONTINUABLE);
  130.  
  131.   /* Should lock it for parallel safety I suppose... */
  132.  
  133.   /* Build a list of host machine and port number... */
  134.  
  135.   if (ntohs(sock->LISTENER.name.sin_port) > 0x7ffffff)
  136.     CallError(stacktop,
  137.           "listener-id: port number overflow!",sock,NONCONTINUABLE);
  138.  
  139.   STACK(sock);
  140.  
  141.   data = (LispObject)
  142.          allocate_integer(stacktop,(int) ntohs(sock->LISTENER.name.sin_port));
  143.   EUCALLSET_2(data , Fn_cons, SYSTEM_GLOBAL_VALUE(host_machine_lisp_name),
  144.           data);
  145.  
  146.   return(data);
  147. }
  148. EUFUN_CLOSE
  149.  
  150. EUFUN_1( Fn_listen, sock)
  151. {
  152.   LispObject new;
  153.   int length;
  154.  
  155.   if (!is_listener(sock))
  156.     CallError(stacktop,"listen: not a listener",sock,NONCONTINUABLE);
  157.  
  158.   if (sock->LISTENER.state != SOCKET_VIRGIN)
  159.     CallError(stacktop,"listen: listener not virgin",sock,NONCONTINUABLE);
  160.  
  161.   /* All is cool... */
  162.  
  163.   sock->LISTENER.state = SOCKET_LISTENING;
  164.  
  165.   sock->LISTENER.state = SOCKET_VIRGIN;
  166.  
  167.   /* Give back a 'copy'... */
  168.  
  169.   new = allocate_socket(stacktop);
  170.   lval_classof(new) = Socket; 
  171.  
  172.   new->SOCKET.state = SOCKET_CONNECTED;
  173.  
  174.   length = sizeof(SocketInName);
  175.  
  176.   new->SOCKET.socket = accept(sock->SOCKET.socket,
  177.                   (SocketName *) &(new->SOCKET.name),
  178.                   &length);
  179.  
  180.   if (new->SOCKET.socket < 0)
  181.     CallError(stacktop,"listen: unable to accept connection"
  182.           ,sock,NONCONTINUABLE);
  183.  
  184.   /* All is cool I think... */
  185.  
  186.   return(new);
  187. }
  188. EUFUN_CLOSE
  189.  
  190. EUFUN_1( Fn_connect, data)
  191. {
  192.   LispObject sock;
  193.   LispObject hostname,port;
  194.   Host *hostptr;
  195.   SocketInName their_name;
  196.  
  197.   if (!is_cons(data))
  198.     CallError(stacktop,"connect: invalid socket data",data,NONCONTINUABLE);
  199.  
  200.   hostname = CAR(data); port = CDR(data);
  201.  
  202.   if (!is_symbol(hostname) || !is_fixnum(port))
  203.     CallError(stacktop,"connect: invalid data elts",data,NONCONTINUABLE);
  204.  
  205.   /* Hokay... */
  206.  
  207.   STACK_TMP(port);
  208.   STACK_TMP(hostname);
  209.   sock = allocate_socket(stacktop);
  210.   UNSTACK_TMP(hostname);
  211.   UNSTACK_TMP(port);
  212.   lval_classof(sock) = Socket; 
  213.  
  214.   if ((sock->SOCKET.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
  215.     CallError(stacktop,"connect: can't get socket",data,NONCONTINUABLE);
  216.  
  217.   hostptr = gethostbyname(stringof(hostname->SYMBOL.pname));
  218.  
  219.   if (hostptr == NULL)
  220.     CallError(stacktop,"connect: unknown host",hostname,NONCONTINUABLE);
  221.  
  222.   bcopy((char *) (hostptr->h_addr),
  223.     (char *) &(their_name.sin_addr),
  224.     hostptr->h_length);
  225.   their_name.sin_family = AF_INET;
  226.   their_name.sin_port = htons(intval(port));
  227.  
  228.   if (connect(sock->SOCKET.socket,
  229.           (SocketName *) &their_name,
  230.           sizeof(their_name)) < 0) 
  231.     CallError(stacktop,"socket-connect: can't connect",data,NONCONTINUABLE);
  232.  
  233.   /* All is cool (hopefully)... */
  234.  
  235.   sock->SOCKET.state = SOCKET_CONNECTED;
  236.  
  237.   return(sock);
  238. }
  239. EUFUN_CLOSE
  240.  
  241. EUFUN_1( Fn_close_listener, list)
  242. {
  243.   if (!is_listener(list))
  244.     CallError(stacktop,"close-listener: not a listeners",list,NONCONTINUABLE);
  245.  
  246.   if (list->LISTENER.state != SOCKET_VIRGIN)
  247.     CallError(stacktop,"close-listener: not virgin",list,NONCONTINUABLE);
  248.  
  249. #ifdef notdef
  250. /**/  These lines cause trouble on stardents...
  251. /**/  shutdown(list->LISTENER.socket,2);
  252. /**/
  253. /**/  close(list->LISTENER.socket);
  254. #endif
  255.   list->LISTENER.state = SOCKET_CLOSED;
  256.  
  257.  
  258.   return(nil);
  259. }
  260. EUFUN_CLOSE
  261.  
  262. EUFUN_1( Fn_close_socket, sock)
  263. {
  264.   if (!is_socket(sock))
  265.     CallError(stacktop,"close-socket: not a socket",sock,NONCONTINUABLE);
  266.  
  267.   if (sock->SOCKET.state != SOCKET_VIRGIN
  268.       && sock->SOCKET.state != SOCKET_CONNECTED)
  269.     CallError(stacktop,"close-socket: not virgin",sock,NONCONTINUABLE);
  270.  
  271.   shutdown(sock->SOCKET.socket,2);
  272.  
  273.   close(sock->SOCKET.socket);
  274.  
  275.   sock->SOCKET.state = SOCKET_CLOSED;
  276.  
  277.   return(nil);
  278. }
  279. EUFUN_CLOSE
  280.  
  281. EUFUN_2( Fn_socket_write, sock, form)
  282. {
  283.   if (!is_socket(sock))
  284.     CallError(stacktop,"socket-write: not a socket",sock,NONCONTINUABLE);
  285.  
  286.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  287.     CallError(stacktop,
  288.           "socket-write: socket not connected",sock,NONCONTINUABLE);
  289.  
  290.   /* Set up the buffer... */
  291.  
  292.   BUFFER_FORM() = form;
  293.   BUFFER_PTR() = 0;
  294.  
  295.   /* Write form... */
  296.  
  297.   write_object(stacktop,form);
  298.   *(BUFFER()) = '\0';
  299.  
  300. /*  fprintf(stderr,"written: '%s'\n",BUFFER_START()); */
  301.  
  302.   /* OK, now flush the socket... */
  303.  
  304.   /* catch busted pipe signals */
  305.   
  306.   write(sock->SOCKET.socket,(char *) &(BUFFER_PTR()),sizeof(int));
  307.   write(sock->SOCKET.socket,BUFFER_START(),BUFFER_PTR());
  308.  
  309.   return(form);
  310. }
  311. EUFUN_CLOSE
  312.  
  313. #ifdef WITH_SYSTEMV_SOCKETS
  314.  
  315. #include <stropts.h>
  316. #include <poll.h>
  317.  
  318. EUFUN_1( Fn_socket_readable_p, sock)
  319. {
  320.   struct pollfd fds[1];
  321.   unsigned long nfds = 1;
  322.  
  323.   if (!is_socket(sock))
  324.     CallError(stacktop,"socket-readable-p: not a socket",sock,NONCONTINUABLE);
  325.  
  326.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  327.     CallError(stacktop,"socket-readable-p: not connected",sock,NONCONTINUABLE);
  328.  
  329.   fds[0].fd = sock->SOCKET.socket;
  330.   fds[0].events = POLLIN;
  331.   fds[0].revents = 0;
  332.  
  333.   if (poll(fds,nfds,0) < 0)
  334.     CallError(stacktop,"socket-readable-p: poll failed",sock,NONCONTINUABLE);
  335.  
  336.   if (fds[0].revents & POLLIN)
  337.     return(lisptrue);
  338.   else
  339.     return(nil);
  340. }
  341. EUFUN_CLOSE
  342.  
  343. EUFUN_1( Fn_listener_listenable_p, listener)
  344. {
  345.   struct pollfd fds[1];
  346.   unsigned long nfds = 1;
  347.  
  348.   if (!is_listener(listener))
  349.     CallError(stacktop,
  350.           "listener_listenable_p: not a listener",listener,NONCONTINUABLE);
  351.  
  352.   fds[0].fd = listener->SOCKET.socket;
  353.   fds[0].events = POLLIN;
  354.   fds[0].revents = 0;
  355.  
  356.   if (poll(fds,nfds,0) < 0)
  357.     CallError(stacktop,
  358.           "socket-readable-p: poll failed",listener,NONCONTINUABLE);
  359.  
  360.   if (fds[0].revents & POLLIN)
  361.     return(lisptrue);
  362.   else
  363.     return(nil);
  364. }
  365. EUFUN_CLOSE
  366.  
  367. EUFUN_1( Fn_socket_writable_p, sock)
  368. {
  369.   struct pollfd fds[1];
  370.   unsigned long nfds = 1;
  371.  
  372.   if (!is_socket(sock))
  373.     CallError(stacktop,"socket-writable-p: not a socket",sock,NONCONTINUABLE);
  374.  
  375.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  376.     CallError(stacktop,"socket-writable-p: not connected",sock,NONCONTINUABLE);
  377.  
  378.   fds[0].fd = sock->SOCKET.socket;
  379.   fds[0].events = POLLOUT;
  380.   fds[0].revents = 0;
  381.  
  382.   if (poll(fds,nfds,0) < 0)
  383.     CallError(stacktop,"socket-writable-p: poll failed",sock,NONCONTINUABLE);
  384.  
  385.   if (fds[0].revents & POLLOUT)
  386.     return(lisptrue);
  387.   else
  388.     return(nil);
  389. }
  390. EUFUN_CLOSE
  391.  
  392. #else
  393.  
  394. /* BSD... */
  395.  
  396. #include <sys/time.h>
  397.  
  398. EUFUN_1( Fn_socket_readable_p, sock)
  399. {
  400.   fd_set mask;
  401.   struct timeval wait;
  402.  
  403.   if (!is_socket(sock))
  404.     CallError(stacktop,"socket-readable-p: not a socket",sock,NONCONTINUABLE);
  405.  
  406.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  407.     CallError(stacktop,"socket-readable-p: not connected",sock,NONCONTINUABLE);
  408.  
  409.   /* Do a select with 0 timeout... */
  410.  
  411.   wait.tv_sec = 0;
  412.   wait.tv_usec = 0;
  413.  
  414.   FD_ZERO(&mask);
  415.   FD_SET(sock->SOCKET.socket,&mask);
  416.  
  417.   if (select(getdtablesize(),&mask,NULL,NULL,&wait) < 0)
  418.     CallError(stacktop,"socket-readable-p: select failed",sock,NONCONTINUABLE);
  419.  
  420.   if (FD_ISSET(sock->SOCKET.socket,&mask))
  421.     return(lisptrue);
  422.   else
  423.     return(nil);
  424.  
  425.   return(nil);
  426. }
  427. EUFUN_CLOSE
  428.  
  429. EUFUN_1( Fn_listener_listenable_p, listener)
  430. {
  431.   fd_set mask;
  432.   struct timeval wait;
  433.  
  434.   if (!is_listener(listener))
  435.     CallError(stacktop,
  436.           "socket-listenable-p: not a listener",listener,NONCONTINUABLE);
  437.  
  438.   /* Do a select with 0 timeout... */
  439.  
  440.   wait.tv_sec = 0;
  441.   wait.tv_usec = 0;
  442.  
  443.   FD_ZERO(&mask);
  444.   FD_SET(listener->LISTENER.socket,&mask);
  445.  
  446.   if (select(getdtablesize(),&mask,NULL,NULL,&wait) < 0)
  447.     CallError(stacktop,
  448.           "socket-readable-p: select failed",listener,NONCONTINUABLE);
  449.  
  450.   if (FD_ISSET(listener->LISTENER.socket,&mask))
  451.     return(lisptrue);
  452.   else
  453.     return(nil);
  454.  
  455.   return(nil);
  456. }
  457. EUFUN_CLOSE
  458.  
  459. EUFUN_1( Fn_socket_writable_p, sock)
  460. {
  461.   fd_set mask;
  462.   struct timeval wait;
  463.  
  464.   if (!is_socket(sock))
  465.     CallError(stacktop,
  466.           "socket-readable-p: not a socket",sock,NONCONTINUABLE);
  467.  
  468.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  469.     CallError(stacktop,
  470.           "socket-readable-p: not connected",sock,NONCONTINUABLE);
  471.  
  472.   /* Do a select with 0 timeout... */
  473.  
  474.   wait.tv_sec = 0;
  475.   wait.tv_usec = 0;
  476.  
  477.   FD_ZERO(&mask);
  478.   FD_SET(sock->SOCKET.socket,&mask);
  479.  
  480.   if (select(getdtablesize(),NULL,&mask,NULL,&wait) < 0)
  481.     CallError(stacktop,"socket-readable-p: select failed",sock,NONCONTINUABLE);
  482.  
  483.   if (FD_ISSET(sock->SOCKET.socket,&mask))
  484.     return(lisptrue);
  485.   else
  486.     return(nil);
  487.  
  488.   return(nil);
  489.  
  490. }
  491. EUFUN_CLOSE
  492.  
  493. #endif
  494.  
  495. EUFUN_1( Fn_socket_read, sock)
  496. {
  497.   int len,ret;
  498.   LispObject obj;
  499.  
  500.   if (!is_socket(sock))
  501.     CallError(stacktop,"socket-read: not a socket",sock,NONCONTINUABLE);
  502.  
  503.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  504.     CallError(stacktop,"socket-read: not connected",sock,NONCONTINUABLE);
  505.  
  506. #ifdef NOTDEFINED    /* Allow this call to block */
  507.   if (Fn_socket_readable_p(sock) == nil)
  508.     CallError(stacktop,"socket-read: socket unreadable",sock,NONCONTINUABLE);
  509. #endif
  510.  
  511.   /* Get the length... */
  512.  
  513.   if ( (ret = read(sock->SOCKET.socket,(char *) &len,sizeof(int))) == -1)
  514.     {
  515.       CallError(stacktop,
  516.         "socket-read: could not read socket",sock,NONCONTINUABLE);
  517.     }
  518.  
  519.   /* Read the data... */
  520.  
  521.   if ((ret = read(sock->SOCKET.socket,(char *) (BUFFER_START()),len)) == -1)
  522.     {
  523.       CallError(stacktop,
  524.         "socket-read: could not complete socket-read",
  525.         sock,NONCONTINUABLE);
  526.     }
  527.  
  528. /*  fprintf(stderr,"read: '%s'\n",BUFFER_START()); */
  529.  
  530.   *(BUFFER_START() + len) = '\0';
  531.   *(BUFFER_START() + len + 1) = '\n';
  532.  
  533.   /* Set up buffer... */
  534.  
  535.   BUFFER_PTR() = 0;
  536.  
  537.   obj = read_object(stacktop);
  538.  
  539.   return(obj);
  540. }
  541. EUFUN_CLOSE
  542.  
  543. /* *************************************************************** */
  544. /* Initialisation of this section                                  */
  545. /* *************************************************************** */
  546.  
  547.  
  548. #define SOCKETS_ENTRIES 15
  549. MODULE Module_sockets;
  550. LispObject Module_sockets_values[SOCKETS_ENTRIES];
  551.  
  552. void initialise_sockets(LispObject *stacktop)
  553. {
  554.   extern LispObject Standard_Class,Object, Primitive_Class;
  555.  
  556.   Socket = (LispObject) allocate_class(stacktop,NULL);
  557.   add_root(&Socket);
  558.   Listener = (LispObject) allocate_class(stacktop,NULL);    
  559.   add_root(&Listener);
  560.  
  561.   make_class(stacktop,Listener, "listener",Primitive_Class,Object, 0);
  562.   make_class(stacktop,Socket, "socket",Primitive_Class,Object, 0);  
  563.  
  564.   SYSTEM_INITIALISE_GLOBAL(char *,host_machine_name,NULL);
  565.   SYSTEM_INITIALISE_GLOBAL(Host *,host_machine_ref,NULL);
  566.   SYSTEM_INITIALISE_GLOBAL(LispObject,host_machine_lisp_name,NULL);
  567.   ADD_SYSTEM_GLOBAL_ROOT(host_machine_lisp_name);
  568.  
  569.   SYSTEM_GLOBAL_VALUE(host_machine_name) = (char *) malloc(64);
  570.   gethostname(SYSTEM_GLOBAL_VALUE(host_machine_name),64);
  571.  
  572.   SYSTEM_GLOBAL_VALUE(host_machine_lisp_name)
  573.     = (LispObject) get_symbol(stacktop,SYSTEM_GLOBAL_VALUE(host_machine_name));
  574.  
  575.   open_module(stacktop,
  576.           &Module_sockets,Module_sockets_values,"sockets",SOCKETS_ENTRIES);
  577.   
  578.  
  579.   (void) make_module_function(stacktop,"socketp",Fn_socketp,1);
  580.   (void) make_module_function(stacktop,"make-listener",
  581.                   Fn_make_listener,0);
  582.   (void) make_module_function(stacktop,"make-socket",
  583.                   Fn_make_socket,0);
  584.   (void) make_module_function(stacktop,"listener-id",Fn_listener_id,1);
  585.   (void) make_module_function(stacktop,"listen",Fn_listen,1);
  586.   (void) make_module_function(stacktop,"connect",Fn_connect,1);
  587.   (void) make_module_function(stacktop,"close-listener",Fn_close_listener,1);
  588.   (void) make_module_function(stacktop,"close-socket",Fn_close_socket,1);
  589.   (void) make_module_function(stacktop,"socket-write",Fn_socket_write,2);
  590.   (void) make_module_function(stacktop,"socket-read",Fn_socket_read,1);
  591.   (void) make_module_function(stacktop,"socket-readable-p",Fn_socket_readable_p,1);
  592.   (void) make_module_function(stacktop,"socket-writable-p",Fn_socket_writable_p,1);
  593.   (void) make_module_function(stacktop,"listener-listenable-p",Fn_listener_listenable_p,1);
  594.   (void) make_module_entry(stacktop,"listener",Listener);
  595.   (void) make_module_entry(stacktop,"socket",Socket);
  596.   close_module();
  597.  
  598. }
  599.  
  600. #endif
  601.